﻿module IronLua.Parsing.Parser

open System
open System.Collections.Generic
open IronLua.Parsing.Ast
open IronLua.Parsing.Utilities

let inline valueOf<'T> (token : Token) = 
    match token.LuaValue with
    | Some(value) ->    value :?> 'T
    | None ->           Unchecked.defaultof<'T>

let inline tsym (t : Token) = 
    match t.Type with
    | TokenType.Any 
    | TokenType.Comment 
    | TokenType.EOS 
    | TokenType.Identifier 
    | TokenType.String
    | TokenType.Number ->      sprintf "(%s)" (t.Type.ToString().ToLower())
    | TokenType.Keyword ->     sprintf "%s" (valueOf t)
    | TokenType.Nil ->         "nil"
    | TokenType.True ->        "true"
    | TokenType.False ->       "false"
    | TokenType.Separator
    | TokenType.VarArgs
    | TokenType.Operator ->    t.Terminal
    | _ ->                      IronLua.LuaSyntaxException(sprintf "unknown token \"%s\" at line %i, column %i." t.Terminal t.Position.Line t.Position.Column)
                                |> raise

let inline nrange (left : Expr) (right : Expr) = 
    TokenPosition.Merge left.Position right.Position

let inline ntrange (left : Expr) (right : Token) =
    TokenPosition.Merge left.Position right.Position

let inline tnrange (left : Token) (right : Expr) =
    TokenPosition.Merge left.Position right.Position

let inline trange (left : Token) (right : Token) = 
    TokenPosition.Merge left.Position right.Position

let inline tmatch sym token =    
    (tsym token) = sym

type ScopeType =
    | Function = 0
    | Statement = 1

type SymbolUsage =
    | NonLocal = 0
    | Local = 1
    | Parameter = 2

type Scope = 
    class         
        
        val private depth : int
        val private context : Context
        val internal vars : IDictionary<string, Expr>
        val mutable private locn : int
        val mutable private upvaluen : int
        val internal parent : Scope option
        val private stype : ScopeType

        new(ctx : Context, stype : ScopeType, parent : Scope option) = {
            depth = if Option.isSome parent then parent.Value.depth + 1 else 1;
            parent = parent;
            context = ctx;
            vars = new Dictionary<string, Expr>(10);
            locn = 0;
            upvaluen = 0;
            stype = stype;
        }

        new(ctx : Context, stype : ScopeType) = Scope(ctx, stype, None)
        
        member this.LocalCount with get() = this.locn
        member this.UpValueCount with get() = this.upvaluen

        member this.define((usage : SymbolUsage), (token : Token)) =
            let pos = token.Position
            let sym = valueOf token
            this.define(usage, pos, sym)

        member this.define((usage : SymbolUsage), (pos : TokenPosition), (sym : string)) = 
            match usage with
            | SymbolUsage.Local ->      this.defineLocal    pos sym
            | SymbolUsage.NonLocal ->   this.defineNonLocal pos sym
            | SymbolUsage.Parameter ->  this.defineParam    pos sym
            | _ ->                      parsefailure this.context.source "unknown symbol usage" pos

        member this.resolve(sym : string, pos : TokenPosition) : Expr option = 
            let exists, found = this.vars.TryGetValue(sym)
            if exists then  Some(found)
            else            let hasEnvDefined, foundEnv = this.vars.TryGetValue("_ENV")
                            if hasEnvDefined then   Some(Index(pos, foundEnv, String(pos, sym)))
                            else                    match this.parent with
                                                    | Some(parent) -> match parent.resolve(sym, pos) with
                                                                      | Some(resolved) -> Some(this.translate(parent, resolved, pos))                                                       
                                                                      | None ->           None
                                                    | None ->         None

        member private this.translate(parent, node, pos) =         
            match this.stype with
            | ScopeType.Function ->     match node with
                                        | Local(p, si, i, name) ->      this.defineUpvalue si i name pos
                                        | Parameter(p, si, i, name) ->  this.defineUpvalue si i name pos
                                        | _ ->                          node
            | ScopeType.Statement ->    node
            | _ ->                      parsefailure this.context.source "unknown scope type" pos

        member private this.defineLocal (pos : TokenPosition) (sym : string) = 
            let node = Local(pos, this.depth, this.locn, sym)
            this.locn <- this.locn + 1
            this.vars.[sym] <- node
            node

        member private this.defineNonLocal (pos : TokenPosition) (sym : string) = 
            let _env = Upvalue(pos, 0, 0, 0, "_ENV")
            let node = match sym with 
                       | "_ENV" -> _env
                       | _ ->      Index(pos, _env, String(pos, sym))
            this.vars.[sym] <- node
            node

        member private this.defineParam (pos : TokenPosition) (sym : string) = 
            let node = Parameter(pos, this.depth, this.locn, sym)
            this.locn <- this.locn + 1
            this.vars.[sym] <- node
            node

        member private this.defineUpvalue depth index sym pos = 
            let node = Upvalue(pos, this.upvaluen, depth, index, sym)
            this.upvaluen <- this.upvaluen + 1
            this.vars.[sym] <- node
            node
            
    end

and Context = 
    class
        val mutable private index : int;
        val mutable private curscope : Scope option
        val tokens : IList<Token>
        val source : string

        new(src : string, tokens : Token seq) = {
                index = 0;
                source = src;
                tokens = new List<Token>(tokens)
                curscope = None
            }

        member this.enterFuncScope() = this.enterScope(ScopeType.Function)
        member this.enterStmtScope() = this.enterScope(ScopeType.Statement)

        member private this.enterScope(stype : ScopeType) =
            let newscope = new Scope(this, stype, this.curscope)
            this.curscope <- Some(newscope)
            ()
        member this.mark() = this.index
        member this.rewindTo i = this.index <- i
        member this.rewind() = this.rewindTo (this.index - 1)

        member this.exitScope() =
            let makeVars (s : Scope) = query { for kvp in s.vars do 
                                               let n = kvp.Key
                                               let expr = kvp.Value
                                               where expr.NeedsStorageSlot
                                               select (n, expr) } 
                                       |> Map.ofSeq
            let exitingScope = this.curscope
            let newscope, upn, locn, vars = 
                match exitingScope with
                | Some(scope) -> match scope.parent with 
                                 | Some(parent) -> let upn = parent.UpValueCount
                                                   let locn = parent.LocalCount
                                                   let vars = makeVars parent
                                                   (scope.parent, upn, locn, vars)
                                 | None ->         let upn = scope.UpValueCount
                                                   let locn = scope.LocalCount
                                                   (None, upn, locn, makeVars scope)
                | None ->        parsefailure this.source "no scope" this.token.Position
            this.curscope <- newscope
            (upn, locn, vars)

        member this.scope =     
            match this.curscope with
            | None ->           let scope = new Scope(this, ScopeType.Function) in 
                                this.curscope <- Some(scope)
                                scope
            | Some(scope) ->    scope

        member this.token : Token =
            this.tokens.[this.index]

        member this.lastToken = 
            this.tokens.[this.tokens.Count - 1]

        member this.expect sym = 
            let tsymbol = tsym this.token
            if tsymbol = sym 
            then ignore()
            else parsefailure this.source (sprintf "expected \"%s\", found \"%s\"" sym tsymbol) this.token.Position

        member this.advance() = this.index <- this.index + 1; ()

        member this.advanceAndExpect sym = 
            do  this.advance()
                this.expect sym

        member this.expectAndAdvance sym = 
            do  this.expect sym
                this.advance()

        member this.expectAndAdvanceWithAnyOf syms =
            let tsymbol = tsym this.token
            if tsymbol |> sfindin syms then ()
            else parsefailure this.source (sprintf "expected %s, found %s" (slist syms) tsymbol) this.token.Position

        member this.peekAny() : Token option =
            this.getAt (this.index + 1)

        member this.peek (sym : string) : Token option = 
            match this.getAt (this.index + 1) with
            | None -> None
            | Some(token) -> if (tsym token) = sym then Some(token) else None

        member this.peekAnyOf (syms : string list) : Token option =
            syms |> List.tryPick this.peek

        member this.next() = 
            this.index <- this.index + 1
            match this.getAt this.index with
            | Some(token) ->    token
            | None ->           IronLua.LuaSyntaxException("unexpected end of string.") |> raise
    
        member this.nextWith (sym : string) = 
            match this.peekAny() with
            | Some(token) ->    if tsym token = sym then
                                    this.next()
                                else
                                    parsefailure this.source 
                                                 (sprintf 
                                                          "\"%s\" expected, found \"%s\"" 
                                                          sym (tsym token)) 
                                                 token.Position
            | None ->           IronLua.LuaSyntaxException("unexpected end of string.") |> raise

        member private this.getAt index : (Token option) =
            if index < 0 || index >= this.tokens.Count then 
                None
            else
                let token = this.tokens.[index] in
                Some(token)

    end

type LeftDenotation = Context -> Token -> Expr -> Expr
type NullDenotation = Context -> Token -> Expr

type Binding =
    class
        val symbol : string
        val mutable lbp : int
        val mutable led : LeftDenotation
        val mutable nud : NullDenotation

        new(s : string, p : int) = { 
            symbol = s; 
            lbp = p; 
            led = (fun _ t _ -> IronLua.LuaSyntaxException(sprintf "token \"%s\" has no left denotation."  t.Terminal) |> raise);
            nud = (fun _ t -> IronLua.LuaSyntaxException(sprintf "token \"%s\" has no null denotation."  t.Terminal) |> raise);
        }

    end

let bindings = new Dictionary<string, Binding>(20)

let defbinding sym bp =
    let (exists, binding) = bindings.TryGetValue sym
    if exists then 
        binding.lbp <- bp
        binding 
    else 
        let binding = Binding(sym, bp)
        bindings.[sym] <- binding
        binding

let addbinding (binding : Binding) = 
    bindings.[binding.symbol] <- binding

let setled led (binding : Binding) =
    binding.led <- led
    binding

let setnud nud (binding : Binding) =
    binding.nud <- nud
    binding

let getbinding sym = 
    let (exists, binding) = bindings.TryGetValue(sym)
    if exists then Some(binding) else None

let getTokenBinding (t : Token) (ctx : Context) = 
    let tsymbol = tsym t
    match getbinding (tsymbol) with
    | Some(binding) -> binding
    | None          -> parsefailure ctx.source (sprintf "no binding found for token \"%s\"" tsymbol) t.Position

let led (t : Token) ctx = 
    (getTokenBinding t ctx).led

let nud (t : Token) ctx = 
    (getTokenBinding t ctx).nud

let lbp (t : Token) = 
    let (exists, binding) = bindings.TryGetValue t.Terminal
    if exists then binding.lbp else 0

let expression (rbp : int) (ctx : Context) = 
    let mutable t = ctx.token   
    let mutable tnext = ctx.next()
    let mutable node = (nud t ctx) ctx t
    while rbp < (lbp ctx.token) do        
        t <- ctx.token
        tnext <- ctx.next()
        node <- (led t ctx) ctx t node
    node

let infix sym bp semAct =
    defbinding sym bp
    |> setled (fun ctx token node -> (semAct ctx token node (expression bp ctx)))

let prefix sym bp semAct =
    defbinding sym bp
    |> setnud (fun ctx token -> (semAct ctx token (expression bp ctx)))

let infixr sym bp semAct =
    defbinding sym bp 
    |> setled (fun ctx token node -> (semAct ctx token node (expression (bp - 1) ctx)))

let k sym semAct = 
    defbinding sym 0
    |> setnud (fun ctx token -> semAct ctx token)
    
let group openSym closeSym semAction =
    defbinding openSym 0
    |> setnud semAction

// semantic actions

let resolve (ctx : Context) node = match node with
                                   | Identifier(p, sym) -> match ctx.scope.resolve(sym, p) with
                                                           | Some(var) -> var
                                                           | None -> ctx.scope.define(SymbolUsage.NonLocal, p, sym)
                                   | _ ->                  node

let rec unary (ctx : Context) (token : Token) (next : Expr) = 
    let range = tnrange token next
    match tsym token with
    | "+" -> match next with
             | Expr.Number(p, v) ->  Expr.Number(range, -v) 
             | _ ->                  Expr.Unm(range, resolve ctx next)
    | "-" -> match next with
             | Expr.Number(p, v) ->  Expr.Number(range, -v) 
             | _ ->                  Expr.Unm(range, resolve ctx next)
    | "#" ->                         Expr.Len(range, resolve ctx next)
    | "not" | "!" ->                 Expr.Not(range, resolve ctx next)    
    | _ ->   parsefailure ctx.source (sprintf "unknown unary operator \"%s\"" token.Terminal) token.Position

and ident (ctx : Context) (token : Token) = 
    let sym = valueOf token
    let pos = token.Position
    Identifier(pos, sym)

and tempsymlist (ctx : Context) sep endl =
    if tsym ctx.token <> "(identifier)" then parsefailure ctx.source "identifier expected" ctx.token.Position
    let sym = ctx.token
    ctx.advance()
    let ts = tsym ctx.token
    if ts = sep then        ctx.advance(); sym :: tempsymlist ctx sep endl
    else if ts = endl then  [sym]
    else                    match ctx.token.Type with
                            | TokenType.Keyword
                            | TokenType.Identifier -> [sym]                                          
                            | _ ->                     parsefailure ctx.source (sprintf "'%s' unexpected" ts) ctx.token.Position

and identlist usage (ctx: Context) sep =
    if tsym ctx.token <> "(identifier)" then parsefailure ctx.source "identifier expected" ctx.token.Position
    let id = ctx.scope.define(usage, ctx.token)
    ctx.advance()
    if (tsym ctx.token) = sep then ctx.advance(); id :: identlist usage ctx sep else [id]
   
and index sym bp semAct = infix sym bp semAct
   
and indexer (ctx : Context) token left right = 
    let indexee = match left with
                  | Expr.Identifier(p, sym) -> match ctx.scope.resolve(sym, p) with
                                               | Some(var) -> var
                                               | None ->      ctx.scope.define(SymbolUsage.NonLocal, p, sym)
                  | _ ->                       left
    let indexer = match right with
                  | Expr.Identifier(p, sym) -> String(p, sym)
                  | _ ->                       parsefailure ctx.source "identifier expected" right.Position
    let range = nrange left right
    match tsym token with 
    | "." -> Expr.Index(range, indexee, indexer)
    | _ ->   parsefailure ctx.source (sprintf "unknown indexer operator \"%s\"" token.Terminal) token.Position

and indexer2 (ctx : Context) token left =   
    let left = match left with
               | Expr.Identifier(p, sym) -> match ctx.scope.resolve(sym, p) with
                                            | Some(var) -> var
                                            | None ->      ctx.scope.define(SymbolUsage.NonLocal, p, sym)
               | _ ->                       left 
    let inner = match expression 0 ctx with
                | Expr.Identifier(p, sym) -> match ctx.scope.resolve(sym, p) with
                                             | Some(var) -> var
                                             | None ->      ctx.scope.define(SymbolUsage.NonLocal, p, sym)
                | _ as expr ->               expr
    let range = ntrange left ctx.token
    let node = Expr.Index(range, left, inner)
    ctx.expectAndAdvance "]"
    node

and groupOrCoalesce (ctx : Context) (token : Token) =
    let ret = match tsym ctx.token with 
              | ")" -> parsefailure ctx.source "expression expected" ctx.token.Position
              | _ ->   expression 0 ctx
    ctx.expectAndAdvance ")"
    match ret with 
    | Expr.Call(p, fn, parms) -> Expr.CoalesceResults(p, ret)
    | Expr.VarArgsExpr(p) ->             Expr.CoalesceResults(p, ret)
    | _ -> ret

and parseExprList index (ctx : Context) (seps : string list) = 
    let expr1 = expression 0 ctx
    let tsymbol = tsym ctx.token
    if tsymbol |> sfindin seps then
        ctx.advance();
        let expr = match expr1 with 
                   | Call(p, callee, parms) ->    if index = 0 
                                                  then Expr.CoalesceResults(p, expr1)
                                                  else expr1
                   | Expr.Identifier(p, sym) ->   match ctx.scope.resolve(sym, p) with 
                                                  | Some(resolved) -> resolved
                                                  | None ->           expr1
                   | _ ->                         expr1
                   
        expr :: parseExprList (index + 1) ctx seps
    else
        match expr1 with
        | Expr.Identifier(p, sym) -> match ctx.scope.resolve(sym, p) with
                                     | Some(resolved) -> [resolved]
                                     | None ->           [expr1]
        | _ -> [expr1]

and lvalues index (ctx : Context) (seps : string list) =
    let expr = match expression 0 ctx with
               | Expr.Identifier(p, sym) ->             match ctx.scope.resolve(sym, p) with
                                                        | Some(existing) -> existing
                                                        | None ->           ctx.scope.define(SymbolUsage.NonLocal, p, sym)
               | Expr.Upvalue(p, ui, si, li, n) as e -> e
               | Expr.Local(p, si, li, n) as e ->       e
               | Expr.Parameter(p, si, li, n) as e ->   e
               | Expr.Index(p, indexee, index) as e ->  e
               | _ as e ->                              parsefailure ctx.source "expected assignable expression" e.Position
    let tsymbol = tsym ctx.token
    if tsymbol |> sfindin seps then
        ctx.advance();
        expr :: lvalues (index + 1) ctx seps
    else
        [expr]

and functioncall (ctx : Context) (opensym : Token) (callee : Expr) = 
    let callee = match callee with
                 | Expr.Identifier(p, sym) -> match ctx.scope.resolve(sym, p) with
                                              | Some(existing) -> existing
                                              | None ->           ctx.scope.define(SymbolUsage.NonLocal, p, sym)
                 | _ ->                       callee
    let parms = match tsym opensym with                
                | "(string)" -> [ Expr.String(opensym.Position, valueOf opensym) ]
                | "{" ->        [ tabledef ctx opensym ]                                    
                | "(" ->        if tsym ctx.token = ")" then 
                                    ctx.advance(); [] 
                                else
                                    let exprlist = 
                                        match tsym ctx.token with 
                                        | "|" ->    shortclosureex ctx ctx.token [","] :: parseExprList 0 ctx [","]
                                        | _ ->      parseExprList 0 ctx [","]
                                    do ctx.expectAndAdvance ")"
                                    exprlist
                | _ ->          parsefailure ctx.source "expected string, table or parameter list in function call" opensym.Position
    let range = ntrange callee ctx.token
    Expr.Call(range, callee, parms)

and getCallingObj callee = 
    match callee with
    | Index(p, indexee, indexer) -> indexee
    | _ ->                          callee

and selfcall (ctx : Context) (separator : Token) (callee : Expr) =
    let rescal = match callee with
                  | Expr.Identifier(p, sym) ->  match ctx.scope.resolve(sym, p) with
                                                | Some(resolved) -> resolved
                                                | None ->           ctx.scope.define(SymbolUsage.NonLocal, p, sym)
                  | _ ->                        callee
    let indexer = Identifier(ctx.token.Position, valueOf ctx.token)
    let callee = match tsym ctx.token with 
                 | "(identifier)" -> let id = Expr.Index(ntrange rescal ctx.token, 
                                                         rescal, 
                                                         indexer)
                                     ctx.advance(); id
                 | _ ->              parsefailure ctx.source 
                                                  "identifier expected" 
                                                  ctx.token.Position
    let opensym = ctx.token
    ctx.advance()
    let fnnode = functioncall ctx opensym callee
    let ret = match fnnode with
              | Expr.Call(p, callee, parms) ->  let callingobj = getCallingObj callee
                                                Expr.Call(p, callee, callingobj :: parms)
              | _ ->                            parsefailure ctx.source "function expected" fnnode.Position
    ret

and semicolon (ctx : Context) = 
    let token = ctx.token
    ctx.expectAndAdvance ";"
    Expr.Empty ctx.token.Position

and assignment (ctx : Context) = 
    let first = ctx.token
    let lvalues = lvalues 0 ctx [","] 
    let exprlist =  match (tsym ctx.token) with
                    | "=" -> ctx.advance(); parseExprList 0 ctx [","]
                    | _ ->   parsefailure ctx.source (sprintf "expected \"=\", found \"%s\"" (tsym ctx.token)) ctx.token.Position
    Expr.Assign(trange first ctx.token, lvalues, exprlist)

and localvardecl keyword (ctx : Context) = 
    let symbols = tempsymlist ctx "," "="
    let exprlist =  match (tsym ctx.token) with
                    | "=" -> ctx.advance(); parseExprList 0 ctx [","]
                    | _ ->   []
    let names = symbols |> List.map (fun s -> ctx.scope.define(SymbolUsage.Local, s))
    Expr.LocalDecl(trange keyword ctx.token, names, exprlist)

and localdecl (ctx : Context) = 
    let keyword = ctx.token
    let next = ctx.next()
    let snext = tsym next
    match snext with 
    | "(identifier)" -> localvardecl keyword ctx
    | "function" ->     locfundecl keyword ctx
    | _ ->              parsefailure ctx.source (sprintf "expected identifier or \"function\", found \"%s\"" snext) next.Position 

and fname (ctx : Context) = 
    let hasSelf = ref false
    let rec fnamepart depth (ctx : Context) = 
        let tsymbol = tsym ctx.token
        match tsymbol with
        | "(identifier)" -> let t = ctx.token
                            let qualif = if depth < 1 
                                         then ctx.scope.define(SymbolUsage.NonLocal, t)
                                         else Expr.Identifier(ctx.token.Position, valueOf t)
                            let next = ctx.next()
                            let snext = tsym next
                            match snext with 
                            | ":" -> hasSelf := true
                                     let name = ctx.nextWith("(identifier)") in
                                     let node = Expr.Identifier(ctx.token.Position, valueOf ctx.token)
                                     ctx.advance()
                                     [ qualif; node ]
                            | "." -> ctx.advanceAndExpect"(identifier)"; qualif :: fnamepart (depth + 1) ctx
                            | "(" -> [ qualif ]
                            | _ -> parsefailure ctx.source
                                                (sprintf "expected \".\", \":\" or \"(\", found \"%s\"" tsymbol)
                                                ctx.token.Position

        | _ ->              parsefailure ctx.source 
                                         (sprintf "expected identifier, found \"%s\"" tsymbol)
                                         ctx.token.Position
    ctx.expect "(identifier)"
    let fnamexpr = fnamepart 0 ctx
    let path = fnamexpr 
               |> List.fold (fun acc elem -> match elem with 
                                             | Index(p, a, b) -> elem 
                                             | _ ->              Index(elem.Position, acc, elem)) 
                            (firstOf fnamexpr) 
    let rec getname expr = match expr with
                           | Identifier(p, id) ->          id
                           | Index(p, indexee, indexer) -> getname indexer
                           | String(p, s) ->               s
                           | _ as x ->                     parsefailure ctx.source 
                                                                        (sprintf "expected identifier, found \"%s\"" x.Description)
                                                                        ctx.token.Position
    let name = getname (lastOf fnamexpr)
    (path, name, !hasSelf)

and paramlist (ctx : Context) opensym closesym = 
    let rec readparam (ctx : Context) = 
        let tsymbol = tsym ctx.token
        if tsymbol = closesym then 
            []
        else
            match tsymbol with
            | "..." ->          let t = ctx.token in ctx.advanceAndExpect ")"; 
                                [ Expr.VarArgs(t.Position) ]
            | "(identifier)" -> let t = ctx.token
                                let parm = ctx.scope.define(SymbolUsage.Parameter, t) // Parameter(t.Position, valueOf t)
                                let next = ctx.next()
                                let snext = tsym next
                                match snext with 
                                | "," -> ctx.advance(); parm :: readparam ctx
                                | _ -> [ parm ]
            | _ ->              parsefailure ctx.source 
                                             (sprintf "expected \")\", \"...\" or identifier, found \"%s\"" tsymbol)
                                             ctx.token.Position
    ctx.expectAndAdvance opensym
    let params' = readparam ctx
    ctx.expectAndAdvance closesym
    params'

and locfundecl keyword (ctx: Context) = 
    ctx.advanceAndExpect "(identifier)"
    let name = valueOf ctx.token
    let lhs = ctx.scope.define(SymbolUsage.Local, ctx.token)
    ctx.advanceAndExpect "("
    ctx.enterFuncScope()
    let parms = paramlist ctx "(" ")"
    let body = block ["end"] ctx
    let upn, locn, vars = ctx.exitScope()
    let range = trange keyword ctx.token
    ctx.expectAndAdvance "end"
    Expr.LocalFunDecl(range, Guid.NewGuid(), lhs, parms, body, upn, locn, vars)

and fundecl (ctx : Context) = 
    let keyword = ctx.token
    ctx.expectAndAdvance "function"
    let path, name, hasSelfParam = fname ctx
    ctx.enterFuncScope()
    let parms = if hasSelfParam then let selfparam = ctx.scope.define(SymbolUsage.Parameter, TokenPosition.Virtual, "self")
                                     selfparam :: paramlist ctx "(" ")" 
                                else paramlist ctx "(" ")"
    let body = block ["end"] ctx
    let upn, locn, vars = ctx.exitScope()
    let range = trange keyword ctx.token
    ctx.expectAndAdvance "end"
    Expr.FunDecl(range, Guid.NewGuid(), path, name, parms, body, upn, locn, vars)
   
and ifstmt depth (ctx : Context) = 
    let keyword = ctx.token
    ctx.advance()
    let cond = expression 0 ctx
    ctx.enterStmtScope()
    ctx.expectAndAdvance "then"
    let truepart = block ["end"; "else"; "elseif"] ctx
    let falsepart = match tsym ctx.token with
                    | "elseif" ->   ifstmt (depth + 1) ctx
                    | "else" ->     let keyword = ctx.token
                                    ctx.advance()
                                    ctx.enterStmtScope()
                                    let elsebody = block ["end"] ctx
                                    ctx.exitScope() |> ignore
                                    let range = trange keyword ctx.token
                                    match elsebody with 
                                    | Expr.Block(p, b) ->   Expr.Block(range, b)
                                    | _ ->                  parsefailure ctx.source "block expected after else statement" ctx.token.Position
                    | "end" ->      Expr.Block(TokenPosition.Virtual, [])
                    | _ ->          parsefailure ctx.source "expected \"elseif\", \"else\" or \"end\"" ctx.token.Position
    
    let range = trange keyword ctx.token
    if depth = 0 then ctx.expectAndAdvance "end"
    ctx.exitScope() |> ignore
    Expr.If(range, cond, truepart, falsepart)
    
and elseifstmt (ctx : Context) = 
    let stmt = ifstmt 0 ctx
    stmt

and elsestmt (ctx : Context) = 
    ctx.advance()
    let block' = block ["end"] ctx 
    block'
   
and whilestmt (ctx : Context) = 
    let keyword = ctx.token
    ctx.advance()
    let cond = expression 0 ctx
    ctx.expectAndAdvance "do"
    let block' = block ["end"] ctx
    let range = trange keyword ctx.token
    ctx.expectAndAdvance "end"
    Expr.While(range, cond, block')

and repeatstmt (ctx : Context) = 
    let keyword = ctx.token
    ctx.advance()
    let block' = block ["until"] ctx 
    ctx.expectAndAdvance "until"
    let cond = expression 0 ctx
    let range = trange keyword ctx.token
    Expr.Repeat(range, block', cond)

and numforstmt keyword (ctx : Context) =
    let ident = ctx.scope.define(SymbolUsage.Local, ctx.token)
    ctx.advanceAndExpect "="
    let valueTokens = ctx.next()
    let exprlist = parseExprList 0 ctx [","]
    let values = match exprlist with
                 | a :: b :: [] ->      exprlist
                 | a :: b :: c :: [] -> exprlist
                 | _ ->                 parsefailure ctx.source 
                                                     "wrong number of for iteration values" 
                                                     valueTokens.Position
    ctx.expectAndAdvance "do"
    let block' = block ["end"] ctx
    let range = trange keyword ctx.token
    Expr.For(range, ident, values, block')

and genforstmt keyword (ctx : Context) =
    let varlist = identlist SymbolUsage.Local ctx ","
    ctx.expectAndAdvance "in"
    let exprlist = parseExprList 0 ctx [","]
    ctx.expectAndAdvance "do"
    let block' = block ["end"] ctx
    let range = trange keyword ctx.token
    Expr.GenericFor(range, varlist, exprlist, block')

and forstmt (ctx : Context) = 
    // for Name ‘=’ exp ‘,’ exp [‘,’ exp] do block end
    // for namelist in explist do block end
    let keyword = ctx.token
    ctx.advance()
    ctx.enterStmtScope()
    let for' = match ctx.peek("=") with
               | Some(assn) -> numforstmt keyword ctx
               | None ->       genforstmt keyword ctx
    ctx.expectAndAdvance "end"
    ctx.exitScope() |> ignore
    for'

and gotostmt (ctx : Context) = 
    let keyword = ctx.token
    ctx.advanceAndExpect("(identifier)")
    let label = ctx.token
    ctx.advance()
    Expr.Goto(trange keyword label, valueOf label)

and breakstmt (ctx : Context) = 
    let node = Expr.Break(ctx.token.Position)
    ctx.advance()
    node

and returnstmt (ctx : Context) = 
    let keyword = ctx.token
    ctx.advance()    
    let mark = ctx.mark()
    let exprlist = match ctx.token.Type with 
                   | TokenType.EOS
                   | TokenType.Keyword ->  match tsym ctx.token with
                                            | "function" -> parseExprList 0 ctx [","]
                                            | _ ->          ctx.rewindTo(mark); []                                            
                   | _ ->                   parseExprList 0 ctx [","]
    let range = trange keyword ctx.token
    Expr.Return(range, exprlist)

and endstmt (ctx : Context) = 
    failwith "endstmt"

and shortclosure (ctx : Context) (pipe : Token) = 
    ctx.rewind()
    ctx.enterFuncScope()
    let parmlist = paramlist ctx "|" "|"
    let body = 
        let exprlist = parseExprList 0 ctx [","]
        let range = nrange (firstOf exprlist) (lastOf exprlist)
        Block(range, [Return(TokenPosition.Virtual, exprlist)])

    let upn, locn, vars = ctx.exitScope()
    let range = tnrange pipe body
    Closure(range, Guid.NewGuid(), parmlist, body, upn, locn, vars)

and shortclosureex (ctx : Context) (pipe : Token) (seps : string list) =  
    ctx.enterFuncScope()
    let parms = paramlist ctx "|" "|"
    let body = 
        let expr = expression 0 ctx
        let range = trange pipe ctx.token
        Block(range, [Return(TokenPosition.Virtual, [expr])])

    let upn, locn, vars = ctx.exitScope()
    if tsym ctx.token |> sfindin seps then ctx.advance()    
    let range = tnrange pipe body
    Closure(range, Guid.NewGuid(), parms, body, upn, locn, vars)

and closure (ctx : Context) (first : Token) = 
    ctx.enterFuncScope()
    let parmlist = paramlist ctx "(" ")"
    let body = block ["end"] ctx
    ctx.expectAndAdvance "end"

    let upn, locn, vars = ctx.exitScope()
    let range = tnrange first body
    Closure(range, Guid.NewGuid(), parmlist, body, upn, locn, vars)

and funcallstmt ctx =
    let funcallexpr = expression 0 ctx
    match funcallexpr with
    | Expr.Call(p, callee, parms) -> funcallexpr
    | _ ->                           parsefailure ctx.source "invalid statement" funcallexpr.Position

and tablefieldexpr (ctx : Context) =
    let rec valuePair (ctx : Context) = 
        let opensym = ctx.token
        ctx.advance()
        let value1 = expression 0 ctx
        ctx.expectAndAdvance "]"
        ctx.expectAndAdvance "="
        let value2 = expression 0 ctx
        let range = nrange value1 value2
        Expr.TableValuePair(range, value1, value2)

    let rec keyValuePair key (ctx : Context) =
        do ctx.expectAndAdvance "="
        let value = expression 0 ctx
        let range = nrange key value
        let resolved = match value with
                       | Identifier(p, sym) ->  match ctx.scope.resolve(sym, p) with
                                                | Some(n) ->    n
                                                | None ->       ctx.scope.define(SymbolUsage.NonLocal, p, sym)
                       | _ ->                   value
        Expr.TableKeyValuePair(range, key, resolved)

    let token = ctx.token
    let tsymbol = tsym token
    let field = match tsymbol with
                | "[" -> valuePair ctx
                | _ ->   let expr = expression 0 ctx
                         match expr with
                         | Expr.Identifier(p, id) -> match tsym ctx.token with
                                                     | "=" ->   keyValuePair expr ctx
                                                     | _ ->     Expr.TableItem(expr.Position, expr)
                         | _ ->                      Expr.TableItem(expr.Position, expr)          

    if (tsym ctx.token) |> sfindin [";"; ","] then ctx.advance()
    field
                
and tablefields (ctx : Context) = 
    let token = ctx.token
    match tsym token with
    | "}" -> ctx.advance(); []
    | _ ->   tablefieldexpr ctx :: (tablefields ctx)

and tabledef (ctx : Context) (start : Token) = 
    let fields = tablefields ctx in Expr.Table(trange start ctx.token, fields)

and labeldef (ctx : Context) =
    let dblcolon = ctx.token
    ctx.advanceAndExpect "(identifier)"
    let label = ctx.token
    ctx.advanceAndExpect "::"
    ctx.advance()
    Expr.Label(trange dblcolon ctx.token, valueOf label)

and exprstmt (ctx : Context) =
    let first = ctx.token
    let mark = ctx.mark()
    let expr = expression 0 ctx
    match expr with
    | Expr.Call(p, callee, parms) ->    expr
    | _ ->                              ctx.rewindTo mark; 
                                        try
                                            assignment ctx
                                        with
                                        | _ -> parsefailure ctx.source "function call or assignment expected" first.Position

and statements (endsyms : string list) (ctx : Context) =
    let tsymbol = tsym ctx.token
    if tsymbol |> sfindin endsyms then 
        [] 
    else
        match tsymbol with
        | ";" ->            ctx.advance(); statements endsyms ctx
        | "function" ->     fundecl ctx :: statements endsyms ctx
        | "local" ->        localdecl ctx :: statements endsyms ctx
        | "do" ->           doblock ctx :: statements endsyms ctx
        | "repeat" ->       repeatstmt ctx :: statements endsyms ctx
        | "while" ->        whilestmt ctx :: statements endsyms ctx
        | "for" ->          forstmt ctx :: statements endsyms ctx
        | "if" ->           ifstmt 0 ctx :: statements endsyms ctx
        | "goto" ->         gotostmt ctx :: statements endsyms ctx
        | "break" ->        breakstmt ctx :: statements endsyms ctx
        | "return" ->       let laststmt = returnstmt ctx in 
                            match statements endsyms ctx with 
                            | [] -> [laststmt]
                            | _ ->  parsefailure ctx.source 
                                                 "void statement \"return\" must be the last of its enclosing block" 
                                                 laststmt.Position
        | "::" ->           labeldef ctx :: statements endsyms ctx
        | _ ->              exprstmt ctx :: statements endsyms ctx

and doblock (ctx : Context) = 
    let keyword = ctx.token
    ctx.advance();
    ctx.enterStmtScope()
    let stmts = statements ["end"] ctx
    ctx.exitScope() |> ignore
    ctx.expectAndAdvance "end"
    Expr.Block(trange keyword ctx.token, stmts) 

and block (endsyms : string list) (ctx : Context) = 
    let stmts = statements endsyms ctx
    let range = match stmts with
                | [] ->     TokenPosition.Empty
                | a :: _ -> nrange a (lastOf stmts)
    Expr.Block(range, stmts) 
                
and chunk name (ctx : Context) = 
    ctx.enterFuncScope()
    ctx.scope.vars.Add("_ENV", Upvalue(TokenPosition.Virtual, 0, 0, 0, "_ENV"))
    let stmts = statements ["(eos)"] ctx
    let range = match stmts with
                | [] ->     TokenPosition.Empty
                | a :: _ -> nrange a (lastOf stmts)

    let upn, locn, vars = ctx.exitScope()
    Expr.FunDecl(range, 
                 Guid.NewGuid(),
                 Expr.Empty(TokenPosition.Virtual),
                 name, 
                 [VarArgs(TokenPosition.Virtual)], 
                 Block(range, stmts), 
                 upn + 1, 
                 locn,
                 vars)
          
// expressions

let nil =       k "nil" (fun ctx t -> Expr.Nil(t.Position))
let num =       k "(number)" (fun ctx t -> Expr.Number(t.Position, valueOf t))
let str =       k "(string)" (fun ctx t -> Expr.String(t.Position, valueOf t))
let true' =     k "true" (fun ctx t -> Expr.Boolean(t.Position, valueOf t))
let false' =    k "false" (fun ctx t -> Expr.Boolean(t.Position, valueOf t))
let varargs =   k "..." (fun ctx t -> Expr.VarArgsExpr(t.Position))
let id =        k "(identifier)" ident
let parens =    defbinding "(" 0 |> setnud groupOrCoalesce
let or' =       infix "or" 100 (fun ctx token left right -> Expr.Or(nrange left right, resolve ctx left, resolve ctx right))
let or2 =       infix "||" 100 (fun ctx token left right -> Expr.Or(nrange left right, resolve ctx left, resolve ctx right))
let and' =      infix "and" 110 (fun ctx token left right -> Expr.And(nrange left right, resolve ctx left, resolve ctx right))
let and2 =      infix "&&" 110 (fun ctx token left right -> Expr.And(nrange left right, resolve ctx left, resolve ctx right))
let lt =        infix "<" 120 (fun ctx token left right -> Expr.Lt(nrange left right, resolve ctx left, resolve ctx right))
let gt =        infix ">" 120 (fun ctx token left right -> Expr.Gt(nrange left right, resolve ctx left, resolve ctx right))
let lte =       infix "<=" 120 (fun ctx token left right -> Expr.Lte(nrange left right, resolve ctx left, resolve ctx right))
let gte =       infix ">=" 120 (fun ctx token left right -> Expr.Gte(nrange left right, resolve ctx left, resolve ctx right))
let eq =        infix "==" 120 (fun ctx token left right -> Expr.Eq(nrange left right, resolve ctx left, resolve ctx right))
let neq =       infix "~=" 120 (fun ctx token left right -> Expr.Neq(nrange left right, resolve ctx left, resolve ctx right))
let neq2 =      infix "!=" 120 (fun ctx token left right -> Expr.Neq(nrange left right, resolve ctx left, resolve ctx right))
let concat =    infixr ".." 130 (fun ctx token left right -> Expr.Concat(nrange left right, resolve ctx left, resolve ctx right))
let add =       infix "+" 140 (fun ctx token left right -> Expr.Add(nrange left right, resolve ctx left, resolve ctx right))
let sub =       infix "-" 140 (fun ctx token left right -> Expr.Sub(nrange left right, resolve ctx left, resolve ctx right))
let mul =       infix "*" 150 (fun ctx token left right -> Expr.Mul(nrange left right, resolve ctx left, resolve ctx right))
let div =       infix "/" 150 (fun ctx token left right -> Expr.Div(nrange left right, resolve ctx left, resolve ctx right))
let idiv =      infix "//" 150 (fun ctx token left right -> Expr.IntegerDiv(nrange left right, resolve ctx left, resolve ctx right))
let mod' =      infix "%" 150 (fun ctx token left right -> Expr.Mod(nrange left right, resolve ctx left, resolve ctx right))
let not' =      prefix "not" 160 unary
let not2 =      prefix "!" 160 unary
let unm =       prefix "-" 160 unary
let una =       prefix "+" 160 unary
let len =       prefix "#" 160 unary
let pow =       infixr "^" 170 (fun ctx token left right -> Expr.Pow(nrange left right, resolve ctx left, resolve ctx right))
let index' =    index "." 210 indexer
let index2 =    defbinding "[" 210 |> setled indexer2
let self' =     defbinding ":" 210 |> setled selfcall
let closure' =  defbinding "function" 0 |> setnud closure
let closure2 =  defbinding "|" 0 |> setnud shortclosure
let fncall =    defbinding "(" 200 |> setled functioncall
let fncall3 =   defbinding "(string)" 200 |> setled functioncall
let table =     defbinding "{" 200 |> setnud tabledef |> setled functioncall

// prettyprinter

let prettyPrintExpr node =
    let rec prettyList lst i =
        match lst with
        | [] ->         "]"
        | a :: [] ->    prettify a i + "]"
        | a :: b ->     prettify a i + ", " + prettyList b i
    and prettify node i =
        let indent = new String(' ', i * 4)
        let content =
            match node with 
            | Empty(p) ->           "(none)"
            | Nil(p) ->             "(nil)"
            | Number(p, v) ->       sprintf "(%f)" v
            | String(p, v) ->       sprintf "(string \"%s\")" v
            | VarArgs(p) ->         "(...)"
            | VarArgsExpr(p) ->     "..."
            | Boolean(p, v) ->      sprintf "%b" v
            | Table(p, l) ->        sprintf "(table [%s)" (prettyList l i)
            | TableItem(p, e) ->    sprintf "(item %s)" (prettify e i)
            | TableKeyValuePair(p, k, v) -> sprintf "(kvp %s %s)" (prettify k i) (prettify v i)
            | TableValuePair(p, v1, v2) ->  sprintf "(pair %s %s)" (prettify v1 i) (prettify v2 i)
            | Identifier(p, id) ->   sprintf "\"%s\"" id
            | Local(p, si, li, n) -> sprintf "(local %s [scope %i, #%i])" n si li
            | Parameter(p, si, pi, name) -> sprintf "(param %s [scope %i, #%i])" name si pi
            | Upvalue(p, ui, si, li, name) -> sprintf "(upvalue %s [#%i from scope %i, local %i])" name ui si li
            | ClrObj(p, v) ->       sprintf "(obj %A)" v
            | Assign(p, l, r) ->    sprintf "(assign [%s [%s)" (prettyList l i) (prettyList r i)
            | Or(p, l, r) ->        sprintf "(or %s %s)" (prettify l i) (prettify r i)
            | And(p, l, r) ->       sprintf "(and %s %s)" (prettify l i) (prettify r i)
            | Lt(p, l, r) ->        sprintf "(lt %s %s)" (prettify l i) (prettify r i)
            | Gt(p, l, r) ->        sprintf "(gt %s %s)" (prettify l i) (prettify r i)
            | Lte(p, l, r) ->       sprintf "(lte %s %s)" (prettify l i) (prettify r i)
            | Gte(p, l, r) ->       sprintf "(gte %s %s)" (prettify l i) (prettify r i)
            | Eq(p, l, r) ->        sprintf "(eq %s %s)" (prettify l i) (prettify r i)
            | Neq(p, l, r) ->       sprintf "(neq %s %s)" (prettify l i) (prettify r i)
            | Concat(p, l, r) ->    sprintf "(concat %s %s)" (prettify l i) (prettify r i)
            | Add(p, l, r) ->       sprintf "(add %s %s)" (prettify l i) (prettify r i)
            | Sub(p, l, r) ->       sprintf "(sub %s %s)" (prettify l i) (prettify r i)
            | Mul(p, l, r) ->       sprintf "(mul %s %s)" (prettify l i) (prettify r i)
            | IntegerDiv(p, l, r) -> sprintf "(idiv %s %s)" (prettify l i) (prettify r i)
            | Div(p, l, r) ->       sprintf "(div %s %s)" (prettify l i) (prettify r i)
            | Mod(p, l, r) ->       sprintf "(mod %s %s)" (prettify l i) (prettify r i)
            | Not(p, l) ->          sprintf "(not %s)" (prettify l i)
            | Unm(p, l) ->          sprintf "(unm %s)" (prettify l i)
            | Una(p, l) ->          sprintf "(una %s)" (prettify l i)
            | Len(p, v) ->          sprintf "(len %s)" (prettify v i)
            | Pow(p, l, r) ->       sprintf "(pow %s %s)" (prettify l i) (prettify r i)
            | Label(p, lbl) ->      sprintf "(label %s)" lbl
            | Goto(p, lbl) ->       sprintf "(goto %s)" lbl
            | Index(p, l, r) ->     sprintf "(index %s %s)" (prettify l i) (prettify r i)
            | Closure(id, p, parms, body, upn, locn, _) -> sprintf "(closure [%s %s)" (prettyList parms i) (prettify body i)
            | Call(p, fn, parms) -> sprintf "(call %s [%s)" (prettify fn i) (prettyList parms i)
            | If(p, e, t, f) ->     sprintf "(if cond:%s truepart:%s falsepart:%s)" (prettify e i) (prettify t i) (prettify f i)
            | For(p, v, e, b) ->    sprintf "(for %s [%s %s)" (prettify v i) (prettyList e i) (prettify b i)
            | GenericFor(p, v, e, b) -> sprintf "(genfor [%s [%s %s)" (prettyList v i) (prettyList e i) (prettify b i)
            | While(p, c, b) ->     sprintf "(while %s %s)" (prettify c i) (prettify b i)
            | Repeat(p, b, c) ->    sprintf "(repeat %s %s)" (prettify b i) (prettify c i)
            | Break(p) ->           sprintf "(break)"
            | Return(p, e) ->       sprintf "(return [%s)" (prettyList e i)
            | CoalesceResults(p, v) -> sprintf "(coalesce %s)" (prettify v i)
            | LocalDecl(p, l, e) -> sprintf "(localdecl [%s [%s)" (prettyList l i) (prettyList e i)
            | LocalFunDecl(id, p, lhs, parms, body, upn, locn, _) -> 
                                    sprintf "(local fundecl '%s' [%s %s)"
                                            (prettify lhs (i + 1)) 
                                            (prettyList parms i) 
                                            (prettify body (i + 1))
            | FunDecl(id, p, pt, n, parms, body, upn, locn, _) -> 
                                    sprintf "(fundecl '%s' in %s [%s %s)" 
                                            n 
                                            (prettify pt i) 
                                            (prettyList parms i) 
                                            (prettify body (i + 1))
            | Block(p, l) ->        sprintf "{ [%s }" (prettyList l i)
        content
    sprintf "%s" (prettify node 0)
                                                                                             
let parseString tokenizer path src = 
    let ctx = new Context(src, tokenizer src)    
    ctx |> chunk (path)

let parseExpr tokenizer src =
    let ctx = new Context(src, tokenizer src)
    ctx |> expression 0